home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / ADA / GNAT / !gcc / adainc / 2 / adb / a-stwise < prev    next >
Text File  |  1996-02-12  |  10KB  |  325 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --              A D A . S T R I N G S . W I D E _ S E A R C H               --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.7 $                              --
  10. --                                                                          --
  11. --        Copyright (C) 1992,1993,1994 Free Software Foundation, Inc.       --
  12. --                                                                          --
  13. -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  14. -- terms of the  GNU General Public License as published  by the Free Soft- --
  15. -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16. -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  17. -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18. -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19. -- for  more details.  You should have  received  a copy of the GNU General --
  20. -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  21. -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22. -- MA 02111-1307, USA.                                                      --
  23. --                                                                          --
  24. -- As a special exception,  if other files  instantiate  generics from this --
  25. -- unit, or you link  this unit with other files  to produce an executable, --
  26. -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27. -- covered  by the  GNU  General  Public  License.  This exception does not --
  28. -- however invalidate  any other reasons why  the executable file  might be --
  29. -- covered by the  GNU Public License.                                      --
  30. --                                                                          --
  31. -- GNAT was originally developed  by the GNAT team at  New York University. --
  32. -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  33. --                                                                          --
  34. ------------------------------------------------------------------------------
  35.  
  36. with Ada.Strings.Wide_Maps; use Ada.Strings.Wide_Maps;
  37.  
  38. package body Ada.Strings.Wide_Search is
  39.  
  40.    -----------------------
  41.    -- Local Subprograms --
  42.    -----------------------
  43.  
  44.    function Belongs
  45.      (Element : Wide_Character;
  46.       Set     : Wide_Maps.Wide_Character_Set;
  47.       Test    : Membership)
  48.       return    Boolean;
  49.    pragma Inline (Belongs);
  50.    --  Determines if the given element is in (Test = Inside) or not in
  51.    --  (Test = Outside) the given character set.
  52.  
  53.    -------------
  54.    -- Belongs --
  55.    -------------
  56.  
  57.    function Belongs
  58.      (Element : Wide_Character;
  59.       Set     : Wide_Maps.Wide_Character_Set;
  60.       Test    : Membership)
  61.       return    Boolean is
  62.  
  63.    begin
  64.       if Test = Inside then
  65.          return Is_In (Element, Set);
  66.       else
  67.          return not Is_In (Element, Set);
  68.       end if;
  69.    end Belongs;
  70.  
  71.    -----------
  72.    -- Count --
  73.    -----------
  74.  
  75.    function Count
  76.      (Source   : in Wide_String;
  77.       Pattern  : in Wide_String;
  78.       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  79.       return     Natural
  80.    is
  81.       N : Natural;
  82.       J : Natural;
  83.  
  84.    begin
  85.       if Pattern = "" then
  86.          raise Pattern_Error;
  87.       end if;
  88.  
  89.       --  Handle the case of non-identity mappings by creating a mapped
  90.       --  string and making a recursive call using the identity mapping
  91.       --  on this mapped string.
  92.  
  93.       if Mapping /= Wide_Maps.Identity then
  94.          declare
  95.             Mapped_Source : Wide_String (Source'Range);
  96.  
  97.          begin
  98.             for J in Source'Range loop
  99.                Mapped_Source (J) := Value (Mapping, Source (J));
  100.             end loop;
  101.  
  102.             return Count (Mapped_Source, Pattern);
  103.          end;
  104.       end if;
  105.  
  106.       N := 0;
  107.       J := Source'First;
  108.  
  109.       while J <= Source'Last - (Pattern'Length - 1) loop
  110.          if Source (J .. J + (Pattern'Length - 1)) = Pattern then
  111.             N := N + 1;
  112.             J := J + Pattern'Length;
  113.          else
  114.             J := J + 1;
  115.          end if;
  116.       end loop;
  117.  
  118.       return N;
  119.    end Count;
  120.  
  121.    function Count
  122.      (Source   : in Wide_String;
  123.       Pattern  : in Wide_String;
  124.       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  125.       return     Natural
  126.    is
  127.       Mapped_Source : Wide_String (Source'Range);
  128.  
  129.    begin
  130.       for J in Source'Range loop
  131.          Mapped_Source (J) := Mapping (Source (J));
  132.       end loop;
  133.  
  134.       return Count (Mapped_Source, Pattern);
  135.    end Count;
  136.  
  137.    function Count (Source : in Wide_String;
  138.                    Set    : in Wide_Maps.Wide_Character_Set)
  139.      return Natural
  140.    is
  141.       N : Natural := 0;
  142.  
  143.    begin
  144.       for J in Source'Range loop
  145.          if Is_In (Source (J), Set) then
  146.             N := N + 1;
  147.          end if;
  148.       end loop;
  149.  
  150.       return N;
  151.    end Count;
  152.  
  153.    ----------------
  154.    -- Find_Token --
  155.    ----------------
  156.  
  157.    procedure Find_Token
  158.      (Source : in Wide_String;
  159.       Set    : in Wide_Maps.Wide_Character_Set;
  160.       Test   : in Membership;
  161.       First  : out Positive;
  162.       Last   : out Natural)
  163.    is
  164.    begin
  165.       for J in Source'Range loop
  166.          if Belongs (Source (J), Set, Test) then
  167.             First := J;
  168.  
  169.             for K in J + 1 .. Source'Last loop
  170.                if not Belongs (Source (K), Set, Test) then
  171.                   Last := K - 1;
  172.                   return;
  173.                end if;
  174.             end loop;
  175.  
  176.             --  Here if J indexes 1st char of token, and all chars
  177.             --  after J are in the token
  178.  
  179.             Last := Source'Last;
  180.             return;
  181.          end if;
  182.       end loop;
  183.  
  184.       --  Here if no token found
  185.  
  186.       First := Source'First;
  187.       Last  := 0;
  188.    end Find_Token;
  189.  
  190.    -----------
  191.    -- Index --
  192.    -----------
  193.  
  194.    function Index
  195.      (Source   : in Wide_String;
  196.       Pattern  : in Wide_String;
  197.       Going    : in Direction := Forward;
  198.       Mapping  : in Wide_Maps.Wide_Character_Mapping := Wide_Maps.Identity)
  199.       return     Natural
  200.    is
  201.    begin
  202.       if Pattern = "" then
  203.          raise Pattern_Error;
  204.       end if;
  205.  
  206.       --  Handle the case of non-identity mappings by creating a mapped
  207.       --  string and making a recursive call using the identity mapping
  208.       --  on this mapped string.
  209.  
  210.       if Mapping /= Identity then
  211.          declare
  212.             Mapped_Source : Wide_String (Source'Range);
  213.  
  214.          begin
  215.             for J in Source'Range loop
  216.                Mapped_Source (J) := Value (Mapping, Source (J));
  217.             end loop;
  218.  
  219.             return Index (Mapped_Source, Pattern, Going);
  220.          end;
  221.       end if;
  222.  
  223.       if Going = Forward then
  224.          for J in Source'First .. Source'Last - Pattern'Length + 1 loop
  225.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  226.                return J;
  227.             end if;
  228.          end loop;
  229.  
  230.       else -- Going = Backward
  231.          for J in reverse Source'First .. Source'Last - Pattern'Length + 1 loop
  232.             if Pattern = Source (J .. J + Pattern'Length - 1) then
  233.                return J;
  234.             end if;
  235.          end loop;
  236.       end if;
  237.  
  238.       --  Fall through if no match found. Note that the loops are skipped
  239.       --  completely in the case of the pattern being longer than the source.
  240.  
  241.       return 0;
  242.    end Index;
  243.  
  244.    -----------
  245.    -- Index --
  246.    -----------
  247.  
  248.    function Index
  249.      (Source   : in Wide_String;
  250.       Pattern  : in Wide_String;
  251.       Going    : in Direction := Forward;
  252.       Mapping  : in Wide_Maps.Wide_Character_Mapping_Function)
  253.       return     Natural
  254.    is
  255.       Mapped_Source : Wide_String (Source'Range);
  256.  
  257.    begin
  258.       for J in Source'Range loop
  259.          Mapped_Source (J) := Mapping (Source (J));
  260.       end loop;
  261.  
  262.       return Index (Mapped_Source, Pattern, Going);
  263.    end Index;
  264.  
  265.    function Index
  266.      (Source : in Wide_String;
  267.       Set    : in Wide_Maps.Wide_Character_Set;
  268.       Test   : in Membership := Inside;
  269.       Going  : in Direction  := Forward)
  270.       return   Natural
  271.    is
  272.    begin
  273.       if Going = Forward then
  274.          for J in Source'Range loop
  275.             if Belongs (Source (J), Set, Test) then
  276.                return J;
  277.             end if;
  278.          end loop;
  279.  
  280.       else -- Going = Backward
  281.          for J in reverse Source'Range loop
  282.             if Belongs (Source (J), Set, Test) then
  283.                return J;
  284.             end if;
  285.          end loop;
  286.       end if;
  287.  
  288.       --  Fall through if no match
  289.  
  290.       return 0;
  291.    end Index;
  292.  
  293.    ---------------------
  294.    -- Index_Non_Blank --
  295.    ---------------------
  296.  
  297.    function Index_Non_Blank
  298.      (Source : in Wide_String;
  299.       Going  : in Direction := Forward)
  300.       return   Natural
  301.    is
  302.    begin
  303.       if Going = Forward then
  304.          for J in Source'Range loop
  305.             if Source (J) /= Wide_Space then
  306.                return J;
  307.             end if;
  308.          end loop;
  309.  
  310.       else -- Going = Backward
  311.          for J in reverse Source'Range loop
  312.             if Source (J) /= Wide_Space then
  313.                return J;
  314.             end if;
  315.          end loop;
  316.       end if;
  317.  
  318.       --  Fall through if no match
  319.  
  320.       return 0;
  321.  
  322.    end Index_Non_Blank;
  323.  
  324. end Ada.Strings.Wide_Search;
  325.